Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbdb/sample.frm

Visual Basic Form | 1995-09-06 | 12.2 KB | 416 lines

VERSION 2.00
Begin Form Rollodex
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Sample Address Book"
   ClientHeight    =   4440
   ClientLeft      =   1050
   ClientTop       =   1815
   ClientWidth     =   7560
   Height          =   4845
   Left            =   990
   LinkMode        =   1  'Source
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   7560
   Top             =   1470
   Width           =   7680
   Begin TextBox WorkPhone
      Height          =   372
      Left            =   1680
      TabIndex        =   9
      Text            =   "[phone]"
      Top             =   3960
      Width           =   1332
   End
   Begin TextBox HomePhone
      Height          =   372
      Left            =   1680
      TabIndex        =   8
      Text            =   "[phone]"
      Top             =   3480
      Width           =   1332
   End
   Begin TextBox ThisRec
      Height          =   372
      Left            =   6960
      TabIndex        =   23
      Top             =   3036
      Width           =   492
   End
   Begin TextBox Zip
      Height          =   372
      Left            =   1680
      TabIndex        =   7
      Text            =   "08807"
      Top             =   3000
      Width           =   1092
   End
   Begin TextBox State
      Height          =   372
      Left            =   1680
      TabIndex        =   6
      Text            =   "NJ"
      Top             =   2520
      Width           =   372
   End
   Begin TextBox City
      Height          =   372
      Left            =   1680
      TabIndex        =   5
      Text            =   "Bridgewater"
      Top             =   2040
      Width           =   2292
   End
   Begin CommandButton Quit
      Caption         =   "E&xit"
      Height          =   492
      Left            =   6360
      TabIndex        =   22
      Top             =   1920
      Width           =   1092
   End
   Begin TextBox Address
      Height          =   372
      Left            =   1680
      TabIndex        =   4
      Text            =   "135 Chestnut Street"
      Top             =   1560
      Width           =   3972
   End
   Begin TextBox Contact
      Height          =   372
      Left            =   1680
      TabIndex        =   3
      Text            =   "02/06/1961"
      Top             =   1080
      Width           =   1092
   End
   Begin CommandButton New
      Caption         =   "&New"
      Height          =   492
      Left            =   6360
      TabIndex        =   21
      Top             =   840
      Width           =   1092
   End
   Begin TextBox Lname
      Height          =   372
      Left            =   1680
      TabIndex        =   2
      Text            =   "Marquis"
      Top             =   600
      Width           =   2052
   End
   Begin CommandButton Save
      Caption         =   "&Save"
      Height          =   492
      Left            =   6360
      TabIndex        =   20
      Top             =   240
      Width           =   1092
   End
   Begin TextBox Fname
      Height          =   372
      Left            =   1680
      TabIndex        =   1
      Text            =   "Hank"
      Top             =   120
      Width           =   1092
   End
   Begin VScrollBar Record
      Height          =   4452
      Left            =   5880
      TabIndex        =   0
      Top             =   0
      Width           =   252
   End
   Begin TextBox Text1
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      Height          =   4572
      Left            =   6144
      TabIndex        =   19
      Top             =   -36
      Width           =   1416
   End
   Begin Label Label9
      Alignment       =   1  'Right Justify
      Caption         =   "&Work phone:"
      Height          =   372
      Left            =   480
      TabIndex        =   18
      Top             =   4080
      Width           =   1092
   End
   Begin Label Label8
      Alignment       =   1  'Right Justify
      Caption         =   "&Home phone:"
      Height          =   372
      Left            =   120
      TabIndex        =   17
      Top             =   3600
      Width           =   1452
   End
   Begin Label Label7
      Alignment       =   1  'Right Justify
      Caption         =   "&Zip code:"
      Height          =   372
      Left            =   480
      TabIndex        =   16
      Top             =   3120
      Width           =   1092
   End
   Begin Label Label10
      Alignment       =   1  'Right Justify
      BackColor       =   &H00C0C0C0&
      Caption         =   "Record no:"
      Height          =   492
      Left            =   6168
      TabIndex        =   24
      Top             =   3000
      Width           =   768
   End
   Begin Label Label6
      Alignment       =   1  'Right Justify
      Caption         =   "&State:"
      Height          =   372
      Left            =   480
      TabIndex        =   15
      Top             =   2640
      Width           =   1092
   End
   Begin Label Label5
      Alignment       =   1  'Right Justify
      Caption         =   "&City:"
      Height          =   372
      Left            =   480
      TabIndex        =   14
      Top             =   2160
      Width           =   1092
   End
   Begin Label Label4
      Alignment       =   1  'Right Justify
      Caption         =   "&Address:"
      Height          =   372
      Left            =   480
      TabIndex        =   13
      Top             =   1680
      Width           =   1092
   End
   Begin Label Label3
      Alignment       =   1  'Right Justify
      Caption         =   "Last &contact:"
      Height          =   372
      Left            =   480
      TabIndex        =   12
      Top             =   1200
      Width           =   1092
   End
   Begin Label Label2
      Alignment       =   1  'Right Justify
      Caption         =   "Last &name:"
      Height          =   372
      Left            =   480
      TabIndex        =   11
      Top             =   720
      Width           =   1092
   End
   Begin Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "&First name:"
      Height          =   252
      Left            =   480
      TabIndex        =   10
      Top             =   240
      Width           =   1092
   End
DefInt A-Z
    '--- make the database handle a shared variable
    Dim Handle
    Dim RecData$
    Dim RecNum&
Sub Address_LostFocus ()
    FldData$ = Address.Text
    PutFLD Handle, Status, 4, FldName$, FldData$, RecData$
End Sub
Sub City_LostFocus ()
    FldData$ = City.Text
    PutFLD Handle, Status, 5, FldName$, FldData$, RecData$
End Sub
Sub ClearForm ()
    '
    'Clears out a form
    '
    FldData$ = ""
    FName.Text = FldData$
    LName.Text = FldData$
    Contact.Text = FldData$
    Address.Text = FldData$
    City.Text = FldData$
    State.Text = FldData$
    Zip.Text = FldData$
    HomePhone.Text = FldData$
    WorkPhone.Text = FldData$
End Sub
Sub Contact_LostFocus ()
    FldData$ = Contact.Text
    PutFLD Handle, Status, 3, FldName$, FldData$, RecData$
End Sub
Sub DisplayRecord (RecNum&)
    ThisRec.Text = LTrim$(Str$(RecNum&))
    ReDim Flds$(0)
    GetFLDS Handle, Status, NumFlds, Flds$(), RecNum&
      If Status Then Exit Sub
    FName.Text = Flds$(1)
    LName.Text = Flds$(2)
    Contact.Text = Flds$(3)
    Address.Text = Flds$(4)
    City.Text = Flds$(5)
    State.Text = Flds$(6)
    Zip.Text = Flds$(7)
    HomePhone.Text = Flds$(8)
    WorkPhone.Text = Flds$(9)
End Sub
Sub EndProgram ()
    '
    'Close database, unload server and exit program
    '
    CloseDBF Handle, Status, 0
    Status = LogOffServer()
    End
End Sub
Sub Fname_LostFocus ()
    FldData$ = FName.Text
    PutFLD Handle, Status, 1, FldName$, FldData$, RecData$
End Sub
Sub Form_Load ()
    '
    'Open the database if, if unsucessful then
    'create it
    '
    '--- logon the server
    Status = LogonServer()
    If Not Status Then End
    '--- open the database
    Mode = 0
    FileName$ = "ROLLODEX.DBF"
    OpenDBF Handle, Status, FileName$, dbftype, Mode
    '--- if can't open it, then create it
    If Status Or (Handle = 0) Then

        ReDim Fld$(0 To 9, 0 To 5)

        Fld$(0, 0) = Str$(9)        'nine fields

        Fld$(1, 2) = Str$(15)       'length
        Fld$(1, 3) = "C"            'character field
        Fld$(1, 4) = "FIRSTNAME"    'field name

        Fld$(2, 2) = Str$(25)       'length
        Fld$(2, 3) = "C"            'character field
        Fld$(2, 4) = "LASTNAME"     'field name

        Fld$(3, 2) = Str$(8)        'length
        Fld$(3, 3) = "D"            'character field
        Fld$(3, 4) = "CONTACT"      'field name
        Fld$(4, 2) = Str$(35)       'length
        Fld$(4, 3) = "C"            'character field
        Fld$(4, 4) = "ADDRESS"      'field name

        Fld$(5, 2) = Str$(15)       'length
        Fld$(5, 3) = "C"            'character field
        Fld$(5, 4) = "CITY"         'field name
        Fld$(6, 2) = Str$(2)        'length
        Fld$(6, 3) = "C"            'character field
        Fld$(6, 4) = "STATE"        'field name
        Fld$(7, 2) = Str$(5)        'length
        Fld$(7, 3) = "N"            'character field
        Fld$(7, 4) = "ZIP"          'field name
        Fld$(8, 2) = Str$(14)       'length
        Fld$(8, 3) = "C"            'character field
        Fld$(8, 4) = "HOMEPHONE"    'field name
        Fld$(9, 2) = Str$(14)       'length
        Fld$(9, 3) = "C"            'character field
        Fld$(9, 4) = "WORKPHONE"    'field name
        Mode = 0
        CreateDBF FileName$, Handle, Fld$(), Mode, Status

        '--- if any errors end program
        If Status Then
            MsgBox "Can't open rollodex", 48, "Error"
            Unload RolloDex
            End
        End If

    End If
    '--- get dbf's statistics
    StatusDBF Handle, FileName$, ftype$, DBTPtr, NumRecs&, NumFlds, RecLen, UpDate$, Status
    '--- fix up for scroll bar
    If NumRecs& = 0 Then NumRecs& = 1
    '--- assign min & max values to scroll bar
    Record.Min = 1
    Record.Max = NumRecs&
End Sub
Sub HomePhone_LostFocus ()
    FldData$ = HomePhone.Text
    PutFLD Handle, Status, 8, FldName$, FldData$, RecData$
End Sub
Sub Lname_LostFocus ()
    FldData$ = LName.Text
    PutFLD Handle, Status, 2, FldName$, FldData$, RecData$
End Sub
Sub New_Click ()

        '
        'Makes a new record
        '
        RecNum& = 0
        ClearForm
        FName.SetFocus
End Sub
Sub Quit_Click ()
    EndProgram
End Sub
Sub Record_Change ()
    '
    'Display the next record
    '
    RecNum& = Record.Value
    DisplayRecord RecNum&
End Sub
Sub Save_Click ()
    SaveForm
End Sub
Sub SaveForm ()
    '
    'Saves a database record to the database.
    'Field data is saved as you tab between
    'fields!
    '
    '--- save the record
    OrigRec& = RecNum&
    PutRec Handle, Status, RecNum&, RecData$
    ThisRec.Text = LTrim$(Str$(RecNum&))
    '--- get dbf's statistics
    If OrigRec& <> RecNum& Then 'record added
        Record.Min = 1
        Record.Max = RecNum&
        Record.Value = RecNum&
    End If
End Sub
Sub State_LostFocus ()
    FldData$ = State.Text
    PutFLD Handle, Status, 6, FldName$, FldData$, RecData$
End Sub
Sub WorkPhone_LostFocus ()
    FldData$ = WorkPhone.Text
    PutFLD Handle, Status, 9, FldName$, FldData$, RecData$
End Sub
Sub Zip_LostFocus ()
    FldData$ = Zip.Text
    PutFLD Handle, Status, 7, FldName$, FldData$, RecData$
End Sub